Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Libraries/SAT 2.3a1/Misc/SATminimalX ƒ/FaceSetFromPICT.p

Text File | 1994-08-23 | 4.9 KB | 172 lines | [TEXT/PJMM]

{Load a set of faces from PICTs, where a DLOG/DITL -preferrably invisible - is used for telling where}
{each face is located. EXPERIMENTAL!}
{}
{For avoiding to waste too much memory, gSAT.offScreen is used for temorarily storing the image}
{PICT, while a new offscreen is allocated for the mask PICT.}
{}
{NOTE:}
{- The DLOG should have an item #1 that is not used (so you can display a PICT there), and item 2 and up for}
{a set of rectangles, e.g. User Items.}
{- You are responsible for restoring gSAT.offScreen after all faces are loaded, i.e. by CopyBits from gSAT.backScreen.}
{- Your face handler gets the actual DITL index, that is from 2 and up!}
{- This code has practically no error checking, so beware of out of memory or erroneous resource numbers!}

unit FaceSetFromPICT;

interface
    uses
        SAT;

    procedure GetFaceSetFromPICT (dlogId, colorPICTid, bwPICTid, maskPICTid: integer; faceHandler: ProcPtr);

implementation

{faceHandler should be a pointer to a procedure declared as:}
{procedure MyFaceHandler(theFace:FacePtr;index: integer);}
{In that procedure, you should save the FacePtr in an appropriate place.}

    procedure CallFaceHandler (theFace: FacePtr; index: integer; myProc: ProcPtr);
    inline
        $205f,     {movea.l  (a7)+,a0        ; (a0) is theFace, 4(a0) is myProc - I think}
        $4e90;


{WARNING: No error checking yet!}


    procedure CreateBWOffScreen (var portP: GrafPtr; rectP: Rect);
        var
            savePort: GrafPtr;
    begin
        GetPort(savePort);
        portP := GrafPtr(NewPtr(sizeof(GrafPort)));
        OpenPort(portP);
        portP^.portRect := rectP;
        portP^.portBits.bounds := portP^.portRect;

        RectRgn(portP^.visRgn, rectP);
        ClipRect(rectP);

        portP^.portBits.rowBytes := longint(((portP^.portRect.right - portP^.portRect.left + 31) div 32) * 4);
        portP^.portBits.baseAddr := NewPtr(portP^.portBits.rowBytes * longint(portP^.portRect.bottom - portP^.portRect.top));

        SetPort(portP);
        EraseRect(portP^.portRect);

        SetPort(savePort);
    end;

    procedure DisposeBWOffscreen (portP: GrafPtr);
        var
            currPort: GrafPtr;
    begin
        begin
            GetPort(currPort);
            if currPort = portP then
                begin
         (* It is; set current port to Window Manager GrafPort *)
                    GetWMgrPort(currPort);
                    SetPort(currPort);
                end;
            ClosePort(portP);
            if portP^.portBits.baseAddr <> nil then
                DisposPtr(portP^.portBits.baseAddr);
            DisposPtr(Ptr(portP));
        end;
    end;

    procedure GetFaceSetFromPICT (dlogId, colorPICTid, bwPICTid, maskPICTid: integer; faceHandler: ProcPtr);
        var
            bounds: Rect;
            thePICT, maskPICT: PicHandle;
            theFace: FacePtr;
            savePort: GrafPtr;
            saveDev: GDhandle;
            theDialog: DialogPtr;
            bwOff: GrafPtr;
            frame, maskFrame: Rect;
            box, zBox: Rect;
            i: integer;
            dlogError: Boolean;
        function GetItemBox (itemNo: integer): Rect;
            var
                kind: integer;
                item: Handle;
                box: Rect;
                tmpStr: Str255;
        begin
            item := Handle(-1);
            GetDItem(theDialog, itemNo, kind, item, box);
            if item = Handle(-1) then {If unchanged, the item does not exist.}
                dlogError := true;
            GetItemBox := box;
        end; {GetItemBox}
    begin
        SATGetPort(savePort, saveDev);

        theDialog := GetNewDialog(dlogId, nil, WindowPtr(-1));

{Get PICTs}
{IDEA: It should really check if the PICT it loads was loaded already, and if it was, don't dispose it.}
        if gSAT.initDepth > 1 then
            thePICT := GetPicture(colorPICTid)
        else
            thePICT := GetPicture(bwPICTid);
        maskPICT := GetPicture(maskPICTid);
        bounds := thePICT^^.picFrame;
        OffsetRect(bounds, -bounds.left, -bounds.top); {onödigt för det gör NewFace åt oss.}

        if (thePICT = nil) or (maskPICT = nil) then
            exit(GetFaceSetFromPICT);

        frame := thePICT^^.picFrame;
        OffsetRect(frame, -frame.left, -frame.top);
        maskFrame := maskPICT^^.picFrame;
        OffsetRect(maskFrame, -maskFrame.left, -maskFrame.top);

        CreateBWOffscreen(bwOff, maskFrame);
        SetPort(bwOff);
        DrawPicture(maskPICT, maskFrame);
        SATSetPort(gSAT.offScreen, gSAT.offScreenGD);
        EraseRect(gSAT.offScreen^.portRect);
        DrawPicture(thePICT, frame);

        dlogError := false;
        i := 2;
        while not dlogError do
            begin
{Draw in the face}
                box := GetItemBox(i);
                if not dlogError then
                    begin
                        zBox := box;
                        OffsetRect(zBox, -box.left, -box.top);
{Create face}
                        theFace := SATNewFace(zBox);
{Draw face}
                        SATSetPortFace(theFace);
                        CopyBits(gSAT.offScreen^.portBits, GrafPtr(gSAT.iconPort)^.portBits, box, zBox, srcCopy, nil);
{Draw mask}
                        SATSetPortMask(theFace);
                        CopyBits(bwOff^.portBits, GrafPtr(gSAT.bwiconPort)^.portBits, box, zBox, srcCopy, nil);

{Tell SAT that we are done}
                        SATChangedFace(theFace);
{Send the face to the host}
                        if faceHandler <> nil then
                            CallFaceHandler(theFace, i, faceHandler);
                        i := i + 1;
                    end;
            end;


{Get rid of the PICTs}
        ReleaseResource(Handle(thePICT));
        ReleaseResource(Handle(maskPICT));
        DisposeDialog(theDialog);

        DisposeBWOffscreen(bwOff);

        SATSetPort(savePort, saveDev);
    end;
end.